home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 1874.ZIP / T-TOOLS.ZIP / CRT2DEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1989-12-19  |  6KB  |  167 lines
  1. {-----------------------------------------------------------------------------}
  2. {                             Turbo Tools                                     }
  3. {                             version 1.0                                     }
  4. {                             for Turbo Pascal 4.0, 5.0 and 5.5               }
  5. {                             Chuck Esterbrook                                }
  6. {                             copyright 1989                                  }
  7. {                                                                             }
  8. {                             See TOOLDOC.ASC for instructions                }
  9. {                                                                             }
  10. {                             program Crt2Demo                                }
  11. {                                                                             }
  12. {-----------------------------------------------------------------------------}
  13.  
  14. {
  15.   program Crt2Demo     - demonstration program for the Crt2 and Keys units
  16.     procedure InitScr      - initialize the crt
  17.     procedure NewWindow    - create a random window with random colors
  18.     procedure RandomChars  - generate random characters until a key is pressed
  19.     procedure RunWindows   - get keyboard input and follow commands
  20. }
  21.  
  22. program Crt2Demo;
  23.  
  24. uses
  25.   crt,
  26.   Crt2,
  27.   Keys;
  28.  
  29.  
  30. procedure InitScr;
  31. begin
  32.   randomize;
  33.   if CanUseColor then begin
  34.     textmode(co80);           { CHANGE TO 80x25/COLOR }
  35.     textmode(co80 + font8x8); { TRY CHANGING TO EXTRA LINE MODE }
  36.                               { FOR EGA AND VGA ADAPTERS }
  37.     textattr := white + blue*16;
  38.   end { if }
  39.   else
  40.     textattr := lightgray + black*16;
  41.   clrscr;
  42.   gotoxy(1,2);
  43.   writeln(Center('Turbo Tools 1.0 * for Turbo Pascal * copyright 1989 * Chuck Esterbrook'));
  44.   Frame(1,1, 80,3, 1,1,1,1);
  45.   gotoxy(1,5);
  46.   writeln(Center('demonstration program for unit Crt2'));
  47.   writeln;
  48.   writeln(Center('Ins=Toggle Insert  Del=Delete Char  Ctrl-Del=Delete Line'));
  49.   writeln(Center('Alt-W=Window  Alt-R=Random  ESCAPE=Quit Program'));
  50.   writeln(Center(#24#25#26#27+' HOME END PAGEUP PAGEDOWN CTR=Move Cursor'));
  51. end; { InitScr }
  52.  
  53.  
  54. procedure NewWindow;
  55. var
  56.   x1,y1,x2,y2,Width,Height : byte;
  57. begin
  58.   x1 := random(70)+1;                    { GET UPPER LEFT HAND CORNER }
  59.   y1 := random(ScrLength-14)+11;
  60.   Width  := random(71)+5;                { GET WIDTH AND HEIGHT }
  61.   Height := random(ScrLength-21)+5;
  62.   x2 := x1 + Width;                      { DETERMINE LOWER RIGHT HAND CORNER }
  63.   y2 := y1 + Height;
  64.   if x2>80        then x2 := 80;         { IF LOWER RIGHT OUT OF BOUNDS PUT }
  65.   if y2>ScrLength then y2 := ScrLength;  { BACK INTO SCREEEN }
  66.  
  67.   window(1,1,80,ScrLength);
  68.   Frame(x1,y1,x2,y2, 2,2,2,2);
  69.   window(x1+1,y1+1,x2-1,y2-1);
  70.  
  71.   if CanUseColor then
  72.     textattr := random(7)+9 + random(8)*16
  73.   else
  74.     case random(4) of
  75.       0 : textattr := lightgray + black*16;
  76.       1 : textattr := white     + black*16;
  77.       2 : textattr := black     + lightgray*16;
  78.       3 : textattr := white     + lightgray*16;
  79.     end; { case }
  80.   clrscr;
  81. end; { NewWindow }
  82.  
  83.  
  84. procedure RandomChars;
  85. begin
  86.   while not keypressed do begin
  87.     write(chr(random(256-32)+32));
  88.   end; { while }
  89.   while keypressed do    { CLEAR KEYBOARD BUFFER }
  90.     while readkey=#0 do;
  91. end; { RandomChars }
  92.  
  93.  
  94. procedure RunWindows;
  95. var
  96.   k : char;
  97.   InsertOn : boolean;
  98. begin
  99.   InsertOn := false;
  100.   while true do begin
  101.     if InsertOn then Cursor(HalfCursor)
  102.                 else Cursor(NormalCursor);
  103.     k := readkey;
  104.     case k of
  105.       _Extended : case readkey of
  106.                     _Up       : gotoxy(wherex,wherey-1);
  107.                     _Down     : gotoxy(wherex,wherey+1);
  108.                     _Left     : if wherex=1 then
  109.                                   gotoxy(lo(windmax)-lo(windmin)+1,wherey-1)
  110.                                 else
  111.                                   gotoxy(wherex-1,wherey);
  112.                     _Right    : if wherex=lo(windmax)-lo(windmin)+1 then
  113.                                   writeln
  114.                                 else
  115.                                   gotoxy(wherex+1,wherey);
  116.                     _Home     : gotoxy(1,wherey);
  117.                     _End      : gotoxy(lo(windmax)-lo(windmin)+1,wherey);
  118.                     _PageUp   : gotoxy(wherex,1);
  119.                     _PageDown : gotoxy(wherex,hi(windmax)-hi(windmin)+1);
  120.                     _Ctr      : gotoxy((lo(windmax)-lo(windmin)+1) div 2,
  121.                                        (hi(windmax)-hi(windmin)+1) div 2);
  122.                     _Ins      : begin
  123.                                   InsertOn := not InsertOn;
  124.                                   if InsertOn then Cursor(HalfCursor)
  125.                                               else Cursor(NormalCursor);
  126.                                 end; { _Insert }
  127.                     _Del      : DelChar(1);
  128.                     _AltW     : NewWindow;
  129.                     _AltR     : RandomChars;
  130.                     _CtrlDel  : delline;
  131.                   end; { case }
  132.       _Backspace : if wherex>1 then begin
  133.                      gotoxy(wherex-1,wherey);
  134.                      DelChar(1);
  135.                    end; { if }
  136.       _Enter     : begin
  137.                      writeln;
  138.                      if InsertOn then insline;
  139.                    end; { _Enter }
  140.       _Escape    : begin
  141.                      if CanUseColor then textmode(co80);
  142.                      textattr := lightgray + black*16;
  143.                      clrscr;
  144.                      writeln('Turbo Tools 1.0 * for Turbo Pascal * copyright 1989 * Chuck Esterbrook');
  145.                      writeln('Crt2 DEMO TERMINATED BY USER');
  146.                      writeln;
  147.                      writeln;
  148.                      writeln;
  149.                      halt;
  150.                    end; { _Escape }
  151.       #32..#254  : begin
  152.                      if InsertOn then
  153.                        InsSpace(1);
  154.                      write(k);
  155.                    end; { normal keys }
  156.     end; { case }
  157.   end; { while }
  158. end; { RunWindows }
  159.  
  160.  
  161. { Crt2Demo }
  162. begin
  163.   InitScr;
  164.   NewWindow;
  165.   RunWindows;
  166. end. { Crt2Demo }
  167.